home *** CD-ROM | disk | FTP | other *** search
/ Multimedia Toolkit / Multimedia Toolkit.iso / pascal / vtcmd.pas < prev    next >
Pascal/Delphi Source File  |  1993-03-31  |  8KB  |  426 lines

  1. UNIT VTCmd;
  2.  
  3. INTERFACE
  4.  
  5. USES Dos, Objects,
  6.      SoundDevices,
  7.      CmdLine;
  8.  
  9.  
  10.  
  11.  
  12. TYPE
  13.   TDoOneProc = FUNCTION(FName, InsidePath: PathStr) : BOOLEAN;
  14.  
  15. CONST
  16.   OneModPtr  : POINTER = NIL;
  17. VAR
  18.   OneMODProc : TDoOneProc ABSOLUTE OneModPtr;
  19.  
  20. TYPE
  21.   TCmdOptions =
  22.     RECORD
  23.       LowQuality : BOOLEAN;
  24.       DevID      : TDevID;
  25.       Freq       : WORD;
  26.       Volume     : WORD;
  27.     END;
  28.  
  29.   TVTCmdSwitch =
  30.     OBJECT(TCmdLineInterpreter)
  31.       PROCEDURE CmdInitShell     (Shell: STRING);        VIRTUAL;
  32.       PROCEDURE InterpretSwitch  (Token: TCmdLine);      VIRTUAL;
  33.       PROCEDURE GetCmdOptions    (VAR Opt: TCmdOptions); VIRTUAL;
  34.       PROCEDURE SetCmdOptions    (VAR Opt: TCmdOptions); VIRTUAL;
  35.     END;
  36.  
  37.   TVTCmd =
  38.     OBJECT(TVTCmdSwitch)
  39.       PROCEDURE InterpretNoSwitch(Token: TCmdLine); VIRTUAL;
  40.     END;
  41.  
  42. VAR
  43.   Cmd      : TVTCmd;
  44.   SongColl : TStringCollection;
  45.  
  46.  
  47.  
  48.  
  49. PROCEDURE SetVTFreq;
  50. PROCEDURE SetVTDevice;
  51.  
  52. FUNCTION DoSongColl(Path: PathStr) : BOOLEAN;
  53.  
  54.  
  55.  
  56.  
  57. IMPLEMENTATION
  58.  
  59. USES VTGlobal, VTScreens,
  60.      SongUnit, SongElements,
  61.      PlayMod, 
  62.      FileUtil;
  63.  
  64.  
  65.  
  66.  
  67. { -------------------------------------------------------------------------- }
  68.  
  69. PROCEDURE SetVTDevice;
  70.   BEGIN
  71.     DevPtr := LocateDevice(DevID);
  72. {
  73.     IF (DevPtr = NIL) OR NOT DevPtr^.Autodetect THEN
  74.       DevPtr := LocateDevice(SpkrDevID);
  75. }
  76.     SetDevice(DevPtr);
  77.   END;
  78.  
  79.  
  80. PROCEDURE SetVTFreq;
  81.   BEGIN
  82.     ChangeSamplingRate(DesiredHz);
  83.   END;
  84.  
  85. { -------------------------------------------------------------------------- }
  86.  
  87. FUNCTION DoAllMODs(DefaultPath: PathStr; Path: PathStr; DoOne: TDoOneProc) : BOOLEAN;
  88.   CONST
  89.     NumExts = 7;
  90.     Exts : ARRAY[0..NumExts] OF ExtStr =
  91.       (
  92.         '.123',
  93.  
  94.         '.MOD', '.STM', '.WOW', '.OKT', '.S2M', '.S3M', '.669'
  95.       );
  96.  
  97.     Dirs : ARRAY[0..3] OF PathStr =
  98.       (
  99.         '',
  100.         '',
  101.         '',
  102.         ''
  103.       );
  104.   VAR
  105.     InsidePath : PathStr;
  106.     Dir        : DirStr;
  107.     Name       : NameStr;
  108.     Ext        : ExtStr;
  109.     DirIdx,
  110.     DirF,
  111.     DirL       : WORD;
  112.     ExtF,
  113.     ExtL       : WORD;
  114.     i, j       : WORD;
  115.     SearchR    : SearchRec;
  116.   LABEL
  117.     Sigue;
  118.   BEGIN
  119.     DoAllMODs := TRUE;
  120.  
  121.     i := Pos('/', Path);
  122.     IF i > 0 THEN
  123.       BEGIN
  124.         InsidePath := Copy(Path, i+1, 255);
  125.         Path       := Copy(Path, 1,   i-1);
  126.       END
  127.     ELSE
  128.       InsidePath := '';
  129.  
  130.     FSplit(Path, Dir, Name, Ext);
  131.     IF Dir <> '' THEN
  132.       BEGIN
  133.         Dirs[0] := FExpand(Dir);
  134.         AddBar2Path(Dirs[0]);
  135.         DirF    := 0;
  136.         DirL    := 0;
  137.       END
  138.     ELSE
  139.       BEGIN
  140.         Dirs[3] := FExpand(ModPath);
  141.         AddBar2Path(Dirs[3]);
  142.  
  143.         DefaultPath := FExpand(DefaultPath);
  144.         AddBar2Path(DefaultPath);
  145.         Dirs[1] := DefaultPath;
  146.  
  147.         DirF := 1;
  148.         DirL := 3;
  149.       END;
  150.  
  151.     Path := FExpand(Path);
  152.     FSplit(Path, Dir, Name, Ext);
  153.  
  154.     IF DirF > 0 THEN
  155.       BEGIN
  156.         Dirs[2] := Dir;
  157.  
  158.         FOR DirIdx := DirL DOWNTO 2 DO
  159.           BEGIN
  160.             FOR i := DirF TO DirIdx - 1 DO
  161.               IF Dirs[DirIdx] = Dirs[i] THEN
  162.                 BEGIN
  163.                   FOR i := DirIdx TO DirL - 1 DO
  164.                     Dirs[i] := Dirs[i+1];
  165.                   DEC(DirL);
  166.                   GOTO Sigue;
  167.                 END;
  168. Sigue:
  169.           END;
  170.       END;
  171.  
  172.  
  173.     IF Ext <> '' THEN
  174.       BEGIN
  175.         Exts[0] := Ext;
  176.         ExtF    := 0;
  177.         ExtL    := 0;
  178.       END
  179.     ELSE
  180.       BEGIN
  181.         ExtF := 1;
  182.         ExtL := NumExts;
  183.       END;
  184.  
  185.     Path := Dir + Name;
  186.  
  187.  
  188.  
  189.     { Loop for all MODs. }
  190.  
  191.     DoAllMODs := FALSE;
  192.  
  193.     FOR j := DirF TO DirL DO
  194.       FOR i := ExtF TO ExtL DO
  195.         BEGIN
  196.           FindFirst(Dirs[j]+Name+Exts[i], ReadOnly, SearchR);
  197.  
  198.           WHILE DosError = 0 DO
  199.             BEGIN
  200.               IF NOT DoOne(Dirs[j] + SearchR.Name, InsidePath) THEN EXIT;
  201.  
  202.               FindNext(SearchR);
  203.             END;
  204.         END;
  205.  
  206.     DoAllMODs := TRUE;
  207.   END;
  208.  
  209.  
  210. { -------------------------------------------------------------------------- }
  211.  
  212.  
  213.  
  214.  
  215. PROCEDURE CmdInitDevice(s: STRING);
  216.   BEGIN
  217.     IF s = '' THEN EXIT;
  218.  
  219.     DevID := s;
  220.  
  221.     SetVTDevice;
  222.   END;
  223.  
  224.  
  225.  
  226.  
  227. PROCEDURE CmdInitFreq(s: STRING);
  228.   VAR
  229.     i, r : WORD;
  230.   BEGIN
  231.     IF s = '' THEN EXIT;
  232.  
  233.     VAL(s, i, r);
  234.     VAL(s, i, r);
  235.     IF r = 0 THEN
  236.       DesiredHz := i;
  237.   END;
  238.  
  239.  
  240.  
  241.  
  242. PROCEDURE CmdInitVolume(s: STRING);
  243.   VAR
  244.     i, r : WORD;
  245.   BEGIN
  246.     IF s = '' THEN EXIT;
  247.  
  248.     VAL(s, i, r);
  249.     IF r = 0 THEN
  250.       BEGIN
  251.         IF i > 255 THEN i := 255;
  252.         VTVolume := i;
  253.       END;
  254.   END;
  255.  
  256. PROCEDURE CmdLoopMod(f: BOOLEAN);
  257.   BEGIN
  258.     VTLoopMod := f;
  259.   END;
  260.  
  261.  
  262. PROCEDURE CmdForceLoop(f: BOOLEAN);
  263.   BEGIN
  264.     ForceLoopMod := f;
  265.   END;
  266.  
  267.  
  268. PROCEDURE CmdLowQuality(f: BOOLEAN);
  269.   BEGIN
  270.     LowQuality := f;
  271.   END;
  272.  
  273.  
  274. PROCEDURE CmdBassFilter(f: BOOLEAN);
  275.   BEGIN
  276.     DoEqualice := f;
  277.   END;
  278.  
  279.  
  280. PROCEDURE CmdInit1stPattern (s: STRING);
  281.   VAR
  282.     i, r : WORD;
  283.   BEGIN
  284.     IF s = '' THEN EXIT;
  285.  
  286.     VAL(s, i, r);
  287.     IF r = 0 THEN
  288.       VT1stPattern := i;
  289.   END;
  290.  
  291.  
  292. PROCEDURE CmdInitSongLen    (s: STRING);
  293.   VAR
  294.     i, r : WORD;
  295.   BEGIN
  296.     IF s = '' THEN EXIT;
  297.  
  298.     VAL(s, i, r);
  299.     IF r = 0 THEN
  300.       VTSongLen := i;
  301.   END;
  302.  
  303.  
  304. PROCEDURE CmdInitRepStart   (s: STRING);
  305.   VAR
  306.     i, r : WORD;
  307.   BEGIN
  308.     IF s = '' THEN EXIT;
  309.  
  310.     VAL(s, i, r);
  311.     IF r = 0 THEN
  312.       VTRepStart := i;
  313.   END;
  314.  
  315.  
  316. (*
  317.   { Read and initialize Sound Blaster timeout value from command line. }
  318.  
  319.   IF ParamStr(4) <> '' THEN BEGIN
  320.     VAL(ParamStr(4), i, r);
  321.     SbSplTimeout := i;
  322.   END;
  323.  
  324.  
  325.  
  326.   { Read and initialize Sound Blaster IRQ value from command line. }
  327.  
  328.   IF ParamStr(5) <> '' THEN BEGIN
  329.     VAL(ParamStr(5), i, r);
  330.     SbIrq := i;
  331.   END;
  332. *)
  333.  
  334.  
  335.  
  336.  
  337. FUNCTION DoSongColl(Path: PathStr) : BOOLEAN;
  338.   VAR
  339.     i : WORD;
  340.   LABEL
  341.     Fin;
  342.   BEGIN
  343.     DoSongColl := TRUE;
  344.     IF SongColl.Count = 0 THEN EXIT;
  345.  
  346.     DoSongColl := FALSE;
  347.     FOR i := 0 TO SongColl.Count - 1 DO
  348.       IF NOT DoAllMODs(Path, PString(SongColl.At(i))^, OneMODProc) THEN GOTO Fin;
  349.     DoSongColl := TRUE;
  350.  
  351. Fin:
  352.     SongColl.FreeAll;
  353.   END;
  354.  
  355.  
  356.  
  357.  
  358. PROCEDURE TVTCmd.InterpretNoSwitch(Token: TCmdLine);
  359.   BEGIN
  360.     SongColl.AtInsert(SongColl.Count, NewStr(Token));
  361.   END;
  362.  
  363.  
  364. PROCEDURE TVTCmdSwitch.CmdInitShell(Shell: STRING);
  365.   VAR
  366.     i, r : WORD;
  367.   BEGIN
  368.     ShellPath  := Shell;
  369.     ShellParam := Copy(Line, Idx, 255);
  370.   END;
  371.  
  372.  
  373. PROCEDURE TVTCmdSwitch.InterpretSwitch  (Token: TCmdLine);
  374.   BEGIN
  375.  
  376.     IF      Token = ''               THEN BEGIN IF NOT DoSongColl(FileDir) THEN Abort; END
  377.     ELSE IF CmpSwitch(Token, 'nobf') THEN CmdBassFilter     (FALSE)
  378.     ELSE IF CmpSwitch(Token, 'bfil') THEN CmdBassFilter     (TRUE)
  379.     ELSE IF CmpSwitch(Token, 'nolp') THEN CmdLoopMod        (FALSE)
  380.     ELSE IF CmpSwitch(Token, 'loop') THEN CmdLoopMod        (TRUE)
  381.     ELSE IF CmpSwitch(Token, 'nofl') THEN CmdForceLoop      (FALSE)
  382.     ELSE IF CmpSwitch(Token, 'flp' ) THEN CmdForceLoop      (TRUE)
  383.     ELSE IF CmpSwitch(Token, 'lq'  ) THEN CmdLowQuality     (TRUE)
  384.     ELSE IF CmpSwitch(Token, 'hq'  ) THEN CmdLowQuality     (FALSE)
  385.     ELSE IF CmpSwitch(Token, 'ss'  ) THEN CmdInit1stPattern (TokenParam(Token))
  386.     ELSE IF CmpSwitch(Token, 'sl'  ) THEN CmdInitSongLen    (TokenParam(Token))
  387.     ELSE IF CmpSwitch(Token, 'sr'  ) THEN CmdInitRepStart   (TokenParam(Token))
  388.     ELSE IF CmpSwitch(Token, 'sh'  ) THEN CmdInitShell      (TokenParam(Token))
  389.     ELSE IF CmpSwitch(Token, 'd'   ) THEN CmdInitDevice     (TokenParam(Token))
  390.     ELSE IF CmpSwitch(Token, 'f'   ) THEN CmdInitFreq       (TokenParam(Token))
  391.     ELSE IF CmpSwitch(Token, 'v'   ) THEN CmdInitVolume     (TokenParam(Token))
  392.     ;
  393.  
  394.   END;
  395.  
  396.  
  397. PROCEDURE TVTCmdSwitch.GetCmdOptions(VAR Opt: TCmdOptions);
  398.   BEGIN
  399.     Opt.LowQuality := LowQuality;
  400.     Opt.DevID      := DevID;
  401.     Opt.Freq       := DesiredHz;
  402.     Opt.Volume     := VTVolume;
  403.  
  404.     SetVTDevice;
  405.   END;
  406.  
  407.  
  408. PROCEDURE TVTCmdSwitch.SetCmdOptions(VAR Opt: TCmdOptions);
  409.   BEGIN
  410.     LowQuality := Opt.LowQuality;
  411.     DevID      := Opt.DevID;
  412.     DesiredHz  := Opt.Freq;
  413.     VTVolume   := Opt.Volume;
  414.  
  415.     SetVTDevice;
  416.   END;
  417.  
  418.  
  419.  
  420.  
  421.  
  422.  
  423.  
  424.  
  425.  
  426. END.